Apple II Magazines (DO)

home *** CD-ROM | disk | FTP | other *** search

/ Apple II Magazines (DO) / Nibble Volume 09, No. 10 (1988-10)(MicroSPARC)(Side B).zip / Nibble Volume 09, No. 10 (1988-10)(MicroSPARC)(Side B).do / HELPER.S < prev next >

Wrap

Text File | 1996-12-24 | 29KB | 494 lines

* * HELPER Source Code * By Kenn Scribner * Copyright (C) 1988 * MicroSparc Inc. * Concord, MA 01742 * * ORCA/M 4.1 Assembler * ORG $7000 ;assemble at $7000 (28672 decimal) 65816 ON ;enable 65816 opcodes LONGA OFF ;use 8 bit accumulator LONGI OFF ;use 8 bit X and Y registers HELPER START * * Local EQUates * A1L EQU $3C ;generic temprorary registers for MOVE A2L EQU $3E A4L EQU $42 LINNUM EQU $50 ;general purpose 16 bit register VARPNT EQU $83 ;last used variable pointer FACLO EQU $A1 ;temporary holding register CHRGET EQU $B1 ;advance TXTPTR to next token/character AMPVECT EQU $3F5 ;ampersand routine vector (pointer) ERROR EQU $D412 ;ASoft error handler CHKCOM EQU $DEBE ;check for comma in program, err if not PTRGET EQU $DFE3 ;locate/create variable at TXTPTR GIVAYF EQU $E2F2 ;float A,Y into FAC for storage GETBYTC EQU $E6F5 ;evaluate formula, return integer value MOVMF EQU $EB2B ;store packed FAC, pointed to by Y,X SETHMEM1 EQU $F28E ;calculate and set HIMEM MOVE EQU $FE2C ;Monitor memory move routine IORTS EQU $FF58 ;Default DOS 3.3 & return address TBCOLOR EQU $E0C022 ;Text/Background color register KYMODREG EQU $E0C025 ;special key register LANGSEL EQU $E0C02B ;language select (display) register CLOCKCTL EQU $E0C034 ;border color register CYAREG EQU $E0C036 ;system speed register ;............................................................... ; ; ProDOS EQUates ;............................................................... GETBUFR EQU $BEF5 ;reserve A pages (256 bytes) above HIMEM KVERSION EQU $BFFF ;ProDOS ID byte (+ ProDOS, - DOS 3.3) ;............................................................... ; ; DOS 3.3 EQUates ;............................................................... MAXFILES EQU $A258 ;DOS 3.3 MAXFILES subroutine * * Beginning of Program Text. * CLC ;begin by storing original values XCE ;enter native mode LDA >CYAREG ;find the current speed AND #$10000000 ;mask out all but speed bit STA SPDMSK+1 ;store for restore LDA >LANGSEL ;find current displayed language AND #%11101000 ;mask out all but language/primary bits STA LANGMSK+1 ;store for restore LDA >TBCOLOR ;find current text/background colors STA TBMSK+1 ;store for restore LDA >CLOCKCTL ;find border color AND #%00001111 ;mask out all but border color bits STA BGMSK+1 ;store for restore SEC ;return to emulation mode XCE LDA KVERSION ;check for ProDOS BPL PRODOS ;positive value means ProDOS loaded DOS33 LDA #$01 ;DOS 3.3 loaded, set MAXFILES = 1 JSR MAXFILES STZ LINNUM ;set HIMEM = $9600 LDA #$96 STA LINNUM+1 JSR SETHMEM1 BNE GOTMEM ;move program (branch always taken) PRODOS LDA #$03 ;reserve 3 pages (3 X 256 bytes) JSR GETBUFR ;request memory from BASIC.SYSTEM BCC GOTMEM ;memory available, no errors MEMERR LDX #$4D ;?OUT OF MEMORY error JMP ERROR GOTMEM PHA ;save returned page number on stack... PHA ;...for later use LDA #<BEGIN ;move program... STA A1L LDA #>BEGIN STA A1L+1 LDA #<END STA A2L LDA #>END STA A2L+1 STZ A4L PLA STA A4L+1 LDY #$00 JSR MOVE ;...move completed LDA #$4C ;"JMP" opcode (making sure it's there) STA AMPVECT LDA AMPVECT+1 ;save old vector (in case you're... STA EXTAMPR+1 ; ...using another & utility) LDA AMPVECT+2 STA EXTAMPR+2 LDA #$00 ;install new vector STA AMPVECT+1 PLA STA AMPVECT+2 RTS ;installed! ;............................................................... ; ; Beginning of real & program (to be moved into operating location). ;............................................................... BEGIN CMP #$5F ;'_' delimiter BEQ PARSE ;'_' found (must be HELPER routine?) EXTAMPR JMP IORTS ;not HELPER routine, try another & pgm. PARSE CLC ;enter native mode XCE SEP #$20 ;set up 8 bit registers SEC ;return to emulation mode XCE JSR CHRGET ;read next token ;............................................................... ; ; LOAD Subroutine (sets new display language). ;............................................................... LDCHK CMP #$B6 ;"LOAD" token value BNE RECHK ;no, check for RESTORE token LOAD JSR CHRGET ;get another token CMP #$D0 ;"=" token value BEQ L1 ;found it, continue LDX #$10 ;not there, generate syntax error JMP ERROR L1 JSR GETBYTC ;return integer language value in X TXA CMP #$08 ;language greater than 8? BCC LVALID ;no, valid language number LDX #$35 ;yes, generate illegal quantity error JMP ERROR LVALID ASL A ;move language to upper three bits ASL A ; (xxxxxYYY to YYYxxxxx, Y = language) ASL A ASL A ASL A ORA #%00001000 ;set bit for primary language (YYYxPxxx) STA FACLO ;save for later masking CLC ;enter native mode XCE LDA >LANGSEL ;load in current language register AND #%00010000 ;clear all mode bits but NTSC/PAL video ORA FACLO ;set new language STA >LANGSEL ;store new language SEC ;return to emulation mode XCE RTS ;done! ;............................................................... ; ; RESTORE Subroutine. Values shown are default values (according to ; the Control Panel). These will be modified to reflect what's ; being used by the system at the moment HELPER is first executed. ;............................................................... RECHK CMP #$AE ;"RESTORE" token value BNE SPCHK ;no, check for SPEED= token RESTORE JSR CHRGET ;yes, point TXTPTR to formula/variable CLC ;enter native mode XCE LDA >CYAREG ;find current speed AND #%01111111 ;set to slow (speed bit = 0) SPDMSK ORA #%10000000 ;speed mask (self-modified before MOVE) STA >CYAREG ;restore system speed LDA >LANGSEL ;find current language AND #%00010000 ;mask out language (leave video bit) LANGMSK ORA #%00011000 ;language mask (self-mod'd before MOVE) STA >LANGSEL ;restore display language TBMSK LDA #%11110110 ;T/B mask (self-modified before MOVE) STA >TBCOLOR ;restore Text/Background colors LDA >CLOCKCTL ;find current border color AND #%11110000 ;clear border color bits BGMSK ORA #%00000110 ;border color mask (self-mod'd) STA >CLOCKCTL ;restore border color SEC ;return to emulation mode XCE RTS ;done! ;............................................................... ; ; SPEED= Subroutine (sets system speed). ;............................................................... SPCHK CMP #$A9 ;"SPEED=" token BNE CLCHK SPEED JSR GETBYTC LDA FACLO ;retrieve current speed BEQ SETSPD ;zero, SLOW speed LDA #$80 ;non-zero, set FAST speed STA FACLO ;save for later masking SETSPD CLC ;enter native mode XCE LDA >CYAREG ;find current speed AND #%01111111 ;zero bit for masking ORA FACLO ;mask bit (sets to "1" if FAST selected) STA >CYAREG ;save new system speed SEC ;return to emulation mode XCE RTS ;done! ;............................................................... ; ; COLOR= Subroutine (sets background color). ;............................................................... CLCHK CMP #$A0 ;"COLOR=" token value BNE HCCHK COLOR JSR GETBYTC TXA CMP #$10 ;color greater than 15 selected? BCC CVALID ;no, valid color LDX #$35 ;yes, illegal quantity error JMP ERROR CVALID STA FACLO ;save color for masking CLC ;enter native mode XCE LDA >TBCOLOR ;find current background color AND #%11110000 ;clear color bits for masking ORA FACLO ;set color bits STA >TBCOLOR ;save new background color SEC ;return to emulation mode XCE RTS ;done! ;............................................................... ; ; HCOLOR= Subroutine (Sets border color). ;............................................................... HCCHK CMP #$92 ;"HCOLOR=" token value BNE TECHK HCOLOR JSR GETBYTC TXA CMP #$10 ;color greater than 15 selected? BCC HVALID ;no, valid color LDX #$35 ;yes, generate illegal quantity error JMP ERROR HVALID STA FACLO ;save color for masking CLC ;enter native mode XCE LDA >CLOCKCTL ;find current border color AND #%11110000 ;clear color bits for masking ORA FACLO ;set color bits STA >CLOCKCTL ;save new border color SEC ;return to emulation mode XCE RTS ;done! ;............................................................... ; ; TEXT Subroutine (Sets text color). ;............................................................... TECHK CMP #$89 ;"TEXT" token value BNE RDCHK TEXT JSR CHRGET ;advance TXTPTR to next token CMP #$D0 ;"=" token value BEQ T1 ;found it, continue LDX #$10 ;not there, generate syntax error JMP ERROR T1 JSR GETBYTC ;return integer text color in X TXA CMP #$10 ;is it greater than 15? BCC TVALID ;no, continue LDX #$35 ;yes, generate illegal quantity error JMP ERROR TVALID ASL A ;move 4 bits to high nibble ASL A ; (xxxxYYYY to YYYYxxxx, Y = color bits) ASL A ASL A STA FACLO ;save for later masking CLC ;enter native mode XCE LDA >TBCOLOR ;find current text color AND #%00001111 ;clear text color bits for masking ORA FACLO ;set text color bits STA >TBCOLOR ;save new text color SEC ;return to emulation mode XCE RTS ;done! ;............................................................... ; ; READ Subroutine (Reads current system values). ;............................................................... RDCHK CMP #$87 ;"READ" token value BEQ READ SYNERR LDX #$10 ;illegal token, generate syntax error JMP ERROR READ JSR CHRGET ;advance TXTPTR to next token CMP #$D0 ;"=" token value BNE SYNERR JSR CHRGET ;advance TXTPTR to string variable JSR PTRGET ;find string text pointer LDY #$01 ;retrieve pointer low byte LDA (VARPNT),Y TAX ;save low byte INY ;retrieve pointer high byte LDA (VARPNT),Y STX VARPNT ;reset VARPNT to point to text data STA VARPNT+1 LDY #$00 ;read first character of string's text LDA (VARPNT),Y AND #%11011111 ;turn character into upper-case letter RDCOLR CMP #'B' ;want background color? BNE RDCAPS ;no, check for Caps Lock status JSR CHKCOM ;yes, now look for comma separator JSR PTRGET ;find/create return status variable CLC ;enter native mode XCE LDA >TBCOLOR ;find current text/background color SEC ;return to native mode XCE AND #%00001111 ;clear text color TAY ;prepare to stuff result into FAC LDA #$00 JSR GIVAYF ;float A,Y into FAC LDX VARPNT ;prepare to store result LDY VARPNT+1 JSR MOVMF ;store result into variable RTS ;done! RDCAPS CMP #'C' ;want Caps Lock status? BNE RDHCOL ;no, check for border color value JSR CHKCOM ;yes, now look for comma separator JSR PTRGET ;find/create return status variable CLC ;enter native mode XCE LDA >KYMODREG ;find current special key register SEC ;return to emulation mode XCE AND #%00000100 ;mask out all bits but Caps Lock BEQ NOCAPS ;if zero, Caps Lock was UP CAPS LDY #$01 ;not zero, Caps Lock was DOWN BNE STUFCAPS ; (forced branch always taken) NOCAPS LDY #$00 ;return zero, Caps Lock was UP STUFCAPS LDA #$00 ;prepare to float result into FAC JSR GIVAYF ;float into FAC LDX VARPNT ;prepare to store result LDY VARPNT+1 JSR MOVMF ;store result RTS ;done! RDHCOL CMP #'H' ;want border color status? BNE RDCTRL ;no, check for Control Key status JSR CHKCOM ;yes, check for comma separator JSR PTRGET ;find/create return status variable CLC ;enter native mode XCE LDA >CLOCKCTL ;find current border color SEC ;return to emulation mode XCE AND #%00001111 ;clear all bits but border color TAY ;prepare to float result into FAC LDA #$00 JSR GIVAYF ;float into FAC LDX VARPNT ;prepare to store result LDY VARPNT+1 JSR MOVMF ;store result RTS ;done! RDCTRL CMP #'K' ;want Control Key status? BNE RDLANG ;no, check for Language JSR CHKCOM ;yes, check for comma separator JSR PTRGET ;find/create return status variable CLC ;enter native mode XCE LDA >KYMODREG ;find current special key register SEC ;return to emulation mode XCE AND #%00000010 ;clear out all bits but Control Key BEQ NOCTRL ;if zero, Ctrl Key is presently UP CTRL LDY #$01 ;not zero, Ctrl Key is presently DOWN BNE STUFCTRL ; (forced branch always taken) NOCTRL LDY #$00 ;return zero, Ctrl Key was UP STUFCTRL LDA #$00 ;prepare to float result into FAC JSR GIVAYF ;float into FAC LDX VARPNT ;prepare to store result LDY VARPNT+1 JSR MOVMF ;store result RTS ;done! RDLANG CMP #'L' ;want current language? BNE RDNKPD ;no check for Numeric Keypad keypress JSR CHKCOM ;yes, check for comma separator JSR PTRGET ;find/create return status variable CLC ;enter native mode XCE LDA >LANGSEL ;find current language SEC ;return to emulation mode XCE AND #%11100000 ;mask out NTSC/PAL and primary bits LSR A ;move 3 bits to low nibble LSR A ; (YYYxxxxx to xxxxxYYY, Y = language) LSR A LSR A LSR A TAY ;prepare to float result into FAC LDA #$00 JSR GIVAYF ;float into FAC LDX VARPNT ;prepare to store result LDY VARPNT+1 JSR MOVMF ;store result RTS ;done! RDNKPD CMP #'N' ;want Numeric Keypad keypress status BNE RDSHFT ;no, check for Shift Key status JSR CHKCOM ;yes, check for comma separator JSR PTRGET ;find/create return status variable CLC ;enter native mode XCE LDA >KYMODREG ;find current special key register SEC ;return to emulation mode XCE AND #%00010000 ;clear out all bits but Numeric Keypad BEQ NONKPD ;if zero, no Numeric Keypad key pressed NKPD LDY #$01 ;not zero, Numeric Keypad key pressed BNE STUFNKPD ; (forced barnch always taken) NONKPD LDY #$00 ;return zero, not a Numeric Keypad key STUFNKPD LDA #$00 ;prepare to float result into FAC JSR GIVAYF ;float into FAC LDX VARPNT ;prepare to store result LDY VARPNT+1 JSR MOVMF ;store result RTS ;done! RDSHFT CMP #'S' ;want Shift Key status? BNE RDTEXT ;no, check for text color JSR CHKCOM ;yes, check for comma separator JSR PTRGET ;find/create return status variable CLC ;enter native mode XCE LDA >KYMODREG ;find current special key register SEC ;return to emulation mode XCE AND #%00000001 ;clear out all bits but Shift key status BEQ NOSHFT ;if zero, Shift Key is not being pressed SHFT LDY #$01 ;not zero, Shift Key is being pressed BNE STUFSHFT ; (forced branch always taken) NOSHFT LDY #$00 ;return zero, Shift Key not pressed STUFSHFT LDA #$00 ;prepare to float result into FAC JSR GIVAYF ;float into FAC LDX VARPNT ;prepare to store result LDY VARPNT+1 JSR MOVMF ;store result RTS ;done! RDTEXT CMP #'T' ;want current text color? BNE RDSPD ;no check for system speed JSR CHKCOM ;yes, check for comma separator JSR PTRGET ;find/create return status variable CLC ;enter native mode XCE LDA >TBCOLOR ;find current text/background color SEC ;return to emulation mode XCE AND #%11110000 ;mask out background color bits LSR A ;move 4 bits to low nibble LSR A ; (YYYYxxxx to xxxxYYYY, Y = color bits) LSR A LSR A TAY ;prepare to float result into FAC LDA #$00 JSR GIVAYF ;float into FAC LDX VARPNT ;prepare to store result LDY VARPNT+1 JSR MOVMF ;store result RTS ;done! RDSPD CMP #'V' ;want current system speed? BEQ V1 ;yes LDX #$35 ;no, illegal quantity error JMP ERROR V1 JSR CHKCOM ;check for comma separator JSR PTRGET ;find/create return status variable CLC ;enter native mode XCE LDA >CYAREG ;find current system speed BPL SLOW ;MSB low, speed set to SLOW FAST LDY #$01 ;speed set to FAST BNE DONE ; (forced branch always taken) SLOW LDY #$00 ;speed set to SLOW DONE SEC ;return to emulation mode XCE LDA #$00 ;prepare to float result into FAC JSR GIVAYF ;float into FAC LDX VARPNT ;prepare to store result LDY VARPNT+1 JSR MOVMF ;store result END RTS ;done! END